home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axcool / axcool.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-10-27  |  15.8 KB  |  389 lines
  1. VERSION 5.00
  2. Begin VB.UserControl axCool 
  3.    Alignable       =   -1  'True
  4.    CanGetFocus     =   0   'False
  5.    ClientHeight    =   450
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   6435
  9.    MaskColor       =   &H00C0C0C0&
  10.    PropertyPages   =   "axCool.ctx":0000
  11.    ScaleHeight     =   30
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   429
  14.    ToolboxBitmap   =   "axCool.ctx":0010
  15.    Begin axCoolbar.axCoolButton btnCool 
  16.       Height          =   330
  17.       Index           =   1
  18.       Left            =   45
  19.       TabIndex        =   0
  20.       ToolTipText     =   "Button1"
  21.       Top             =   45
  22.       Visible         =   0   'False
  23.       Width           =   330
  24.       _ExtentX        =   582
  25.       _ExtentY        =   582
  26.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  27.          Name            =   "MS Sans Serif"
  28.          Size            =   8.25
  29.          Charset         =   0
  30.          Weight          =   400
  31.          Underline       =   0   'False
  32.          Italic          =   0   'False
  33.          Strikethrough   =   0   'False
  34.       EndProperty
  35.       MaskColor       =   -2147483633
  36.    End
  37. Attribute VB_Name = "axCool"
  38. Attribute VB_GlobalNameSpace = False
  39. Attribute VB_Creatable = True
  40. Attribute VB_PredeclaredId = False
  41. Attribute VB_Exposed = True
  42. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  43. Option Explicit
  44. 'Default Property Values:
  45. Const m_def_BorderStyle = 2
  46. 'Property Variables:
  47. Private m_BorderStyle As Integer
  48. Private mNodes As New CollectionEx
  49. Private bShowFlatGrey As Boolean
  50. Private bTextLabels As Boolean
  51. Public Enum AxBorderStyles
  52.     [No Border] = 0
  53.     [Single] = 1
  54.     [Thin Raised] = 2
  55.     [Thick Raised] = 3
  56.     [Thin Inset] = 4
  57.     [Thick Inset] = 5
  58.     [Etched] = 6
  59.     [Bump] = 7
  60. End Enum
  61. 'Event Declarations:
  62. Event Click(Index As Integer)
  63. Attribute Click.VB_Description = "Occurs when the button is pushed"
  64. Event DropDownClick(Index As Integer)
  65. Attribute DropDownClick.VB_Description = "Occurs when the dropdown button is clicked"
  66. Private Sub btnCool_Click(Index As Integer)
  67.   RaiseEvent Click(Index)
  68. End Sub
  69. Private Sub btnCool_DropDownClick(Index As Integer)
  70.   RaiseEvent DropDownClick(Index)
  71. End Sub
  72. 'Initialize Properties for User Control
  73. Private Sub UserControl_InitProperties()
  74.     m_BorderStyle = m_def_BorderStyle
  75.     bShowFlatGrey = False
  76.     bTextLabels = False
  77.     UserControl.Height = 400
  78.     UserControl.Width = 6435
  79. End Sub
  80. Private Sub UserControl_Paint()
  81.     Dim di As Long
  82.     Dim rc As RECT
  83.     'draw outside border
  84.         
  85.     Select Case m_BorderStyle
  86.         Case [No Border]
  87.         
  88.         Case [Single]
  89.             di = GetClientRect(UserControl.hwnd, rc)
  90.             di = DrawEdge(UserControl.hdc, rc, BDR_RAISEDOUTER, BF_RECT Or BF_MONO)
  91.         
  92.         Case [Thin Raised]
  93.             di = GetClientRect(UserControl.hwnd, rc)
  94.             di = DrawEdge(UserControl.hdc, rc, BDR_RAISEDINNER, BF_TOPLEFT)
  95.             di = DrawEdge(UserControl.hdc, rc, BDR_RAISEDOUTER, BF_BOTTOMRIGHT)
  96.         
  97.         Case [Thick Raised]
  98.             di = GetClientRect(UserControl.hwnd, rc)
  99.             di = DrawEdge(UserControl.hdc, rc, EDGE_RAISED, BF_TOPLEFT)
  100.             di = DrawEdge(UserControl.hdc, rc, EDGE_RAISED, BF_BOTTOMRIGHT)
  101.         Case [Thin Inset]
  102.             di = GetClientRect(UserControl.hwnd, rc)
  103.             di = DrawEdge(UserControl.hdc, rc, BDR_SUNKENINNER, BF_TOPLEFT)
  104.             di = DrawEdge(UserControl.hdc, rc, BDR_SUNKENOUTER, BF_BOTTOMRIGHT)
  105.         
  106.         Case [Thick Inset]
  107.             di = GetClientRect(UserControl.hwnd, rc)
  108.             di = DrawEdge(UserControl.hdc, rc, EDGE_SUNKEN, BF_TOPLEFT)
  109.             di = DrawEdge(UserControl.hdc, rc, EDGE_SUNKEN, BF_BOTTOMRIGHT)
  110.         
  111.         Case [Etched]
  112.             di = GetClientRect(UserControl.hwnd, rc)
  113.             di = DrawEdge(UserControl.hdc, rc, EDGE_ETCHED, BF_TOPLEFT)
  114.             di = DrawEdge(UserControl.hdc, rc, EDGE_ETCHED, BF_BOTTOMRIGHT)
  115.         Case [Bump]
  116.             di = GetClientRect(UserControl.hwnd, rc)
  117.             di = DrawEdge(UserControl.hdc, rc, EDGE_BUMP, BF_TOPLEFT)
  118.             di = DrawEdge(UserControl.hdc, rc, EDGE_BUMP, BF_BOTTOMRIGHT)
  119.             
  120.     End Select
  121.         
  122. End Sub
  123. 'Load property values from storage
  124. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  125. Dim iTotCnt As Integer, Index As Integer
  126.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  127.     m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
  128.     bShowFlatGrey = PropBag.ReadProperty("ShowFlatGrey", False)
  129.     bTextLabels = PropBag.ReadProperty("TextLabels", False)
  130.         
  131.         iTotCnt = PropBag.ReadProperty("Count", 0)
  132.         'ReDim mOtlData(totcnt)
  133.         For Index = 1 To iTotCnt
  134.           AddItem
  135.           Set mNodes.Item(Index).Bitmap = PropBag.ReadProperty("List_1" & Index, Nothing)
  136.           mNodes.Item(Index).Caption = PropBag.ReadProperty("List_2" & Index, "")
  137.           mNodes.Item(Index).Enabled = PropBag.ReadProperty("List_3" & Index, 1)
  138.           mNodes.Item(Index).Style = PropBag.ReadProperty("List_4" & Index, 0)
  139.           mNodes.Item(Index).Tag = PropBag.ReadProperty("List_5" & Index, "")
  140.           mNodes.Item(Index).ToolTipText = PropBag.ReadProperty("List_6" & Index, "")
  141.           mNodes.Item(Index).Visible = PropBag.ReadProperty("List_7" & Index, 1)
  142.           mNodes.Item(Index).DropDown = PropBag.ReadProperty("List_8" & Index, 0)
  143.         Next
  144.         
  145.       ShowButtons
  146. End Sub
  147. Private Sub UserControl_Resize()
  148.   If bTextLabels Then
  149.     UserControl.Height = 720
  150.   Else
  151.     UserControl.Height = 400
  152.   End If
  153.   UserControl.Cls
  154.   UserControl_Paint
  155. End Sub
  156. 'Write property values to storage
  157. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  158.     Dim Index As Integer
  159.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  160.     Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
  161.     Call PropBag.WriteProperty("ShowFlatGrey", bShowFlatGrey, False)
  162.     Call PropBag.WriteProperty("TextLabels", bTextLabels, False)
  163.     Call PropBag.WriteProperty("Count", mNodes.Count, 0)
  164.     For Index = 1 To mNodes.Count
  165.       Call PropBag.WriteProperty("List_1" & Index, mNodes(Index).Bitmap)
  166.       Call PropBag.WriteProperty("List_2" & Index, mNodes(Index).Caption)
  167.       Call PropBag.WriteProperty("List_3" & Index, mNodes(Index).Enabled)
  168.       Call PropBag.WriteProperty("List_4" & Index, mNodes(Index).Style)
  169.       Call PropBag.WriteProperty("List_5" & Index, mNodes(Index).Tag)
  170.       Call PropBag.WriteProperty("List_6" & Index, mNodes(Index).ToolTipText)
  171.       Call PropBag.WriteProperty("List_7" & Index, mNodes(Index).Visible)
  172.       Call PropBag.WriteProperty("List_8" & Index, mNodes(Index).DropDown)
  173.     Next
  174. End Sub
  175. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  176. 'MappingInfo=UserControl,UserControl,-1,Enabled
  177. Public Property Get Enabled() As Boolean
  178. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  179.     Enabled = UserControl.Enabled
  180. End Property
  181. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  182.     UserControl.Enabled() = New_Enabled
  183.     PropertyChanged "Enabled"
  184. End Property
  185. Sub ShowAboutBox()
  186. Attribute ShowAboutBox.VB_Description = "Show About box"
  187. Attribute ShowAboutBox.VB_UserMemId = -552
  188.   frmAbout.Show vbModal
  189.   Unload frmAbout
  190.   Set frmAbout = Nothing
  191. End Sub
  192. Public Property Get BorderStyle() As AxBorderStyles
  193. Attribute BorderStyle.VB_Description = "Returns/sets the border style for the control."
  194.     BorderStyle = m_BorderStyle
  195. End Property
  196. Public Property Let BorderStyle(ByVal New_BorderStyle As AxBorderStyles)
  197.     If Not (m_BorderStyle = New_BorderStyle) Then
  198.         m_BorderStyle = New_BorderStyle
  199.         UserControl.Cls
  200.         UserControl_Paint
  201.     End If
  202.     PropertyChanged "BorderStyle"
  203. End Property
  204. ''MappingInfo=UserControl,UserControl,-1,Ambient
  205. 'Public Property Get Ambient() As AmbientProperties
  206. '  Set Ambient = UserControl.Ambient
  207. 'End Property
  208. Public Function Item(ByVal Key As Variant) As Object
  209. Attribute Item.VB_Description = "Sets/gets information on a specific button"
  210.   If VarType(Key) = vbString Then
  211.     Key = Trim(Key)
  212.   End If
  213.   Set Item = mNodes.Item(Key)
  214. End Function
  215. Public Sub AddItem()
  216. Attribute AddItem.VB_Description = "Add blank button to buttons collection"
  217. Attribute AddItem.VB_MemberFlags = "40"
  218.   Dim NewItem As New clsItem, cnt As Integer
  219.   With NewItem
  220.     .Caption = ""
  221.     .Style = 0
  222.     .Tag = ""
  223.     .ToolTipText = ""
  224.     .Visible = 1
  225.     .Enabled = 1
  226.     .DropDown = 0
  227.     Set .Bitmap = Nothing
  228.   End With
  229.   mNodes.Add NewItem, LTrim(Str(mNodes.Count + 1))
  230. End Sub
  231. Public Property Get Count() As Integer
  232. Attribute Count.VB_Description = "Returns number of buttons in button collection"
  233.   Count = mNodes.Count
  234. End Property
  235. Public Sub Remove(Index As Integer)
  236. Attribute Remove.VB_Description = "Removes a specific button"
  237. Attribute Remove.VB_MemberFlags = "40"
  238.   mNodes.Remove Index
  239. End Sub
  240. Public Sub ShowButtons()
  241. Attribute ShowButtons.VB_Description = "Show all buttons"
  242. Attribute ShowButtons.VB_MemberFlags = "40"
  243.   'delete and recreate all buttons
  244.   Dim cnt As Integer, currX As Integer
  245.   Dim iWidth As Integer, iHeight As Integer
  246.   RemoveButtons
  247.   If mNodes.Count = 0 Then
  248.     btnCool(1).Visible = False
  249.   Else
  250.     btnCool(1).Visible = False
  251.     If mNodes.Item(1).DropDown And (mNodes.Item(1).Style = [Cool Button] Or mNodes.Item(1).Style = [Standard Button] Or mNodes.Item(1).Style = [Toolbar Button]) Then
  252.         iWidth = IIf(bTextLabels, 52, 32)
  253.     ElseIf mNodes.Item(1).Style = Separator Or mNodes.Item(1).Style = [Toolbar Handle] Then
  254.         iWidth = 9
  255.     Else
  256.         iWidth = IIf(bTextLabels, 44, 22)
  257.     End If
  258.     iHeight = IIf(bTextLabels, 44, 22)
  259.     btnCool(1).Move 2, 2, iWidth, iHeight
  260.     btnCool(1).Enabled = mNodes.Item(1).Enabled
  261.     btnCool(1).DropDown = mNodes.Item(1).DropDown
  262.     btnCool(1).Caption = IIf(bTextLabels, mNodes.Item(1).Caption, "")
  263.     btnCool(1).ToolTipText = mNodes.Item(1).ToolTipText
  264.     btnCool(1).Tag = mNodes.Item(1).Tag
  265.     btnCool(1).Style = mNodes.Item(1).Style
  266.     btnCool(1).ShowFlatGrey = bShowFlatGrey
  267.     btnCool(1).PictureAlign = vbPicTop
  268.     Set btnCool(1).Picture = IIf(mNodes.Item(1).Bitmap Is Nothing, Nothing, mNodes.Item(1).Bitmap)
  269.     mNodes.Item(1).Left = btnCool(1).Left
  270.     btnCool(1).Visible = mNodes.Item(1).Visible
  271.     For cnt = 2 To mNodes.Count
  272.       Load btnCool(cnt)
  273.       
  274.       btnCool(cnt).Visible = False
  275.       If mNodes.Item(cnt).DropDown And (mNodes.Item(cnt).Style = [Cool Button] Or mNodes.Item(cnt).Style = [Standard Button] Or mNodes.Item(cnt).Style = [Toolbar Button]) Then
  276.         iWidth = IIf(bTextLabels, 52, 32)
  277.       ElseIf mNodes.Item(cnt).Style = Separator Or mNodes.Item(cnt).Style = [Toolbar Handle] Then
  278.         iWidth = 9
  279.       Else
  280.         iWidth = IIf(bTextLabels, 44, 22)
  281.       End If
  282.       iHeight = IIf(bTextLabels, 44, 22)
  283.       btnCool(cnt).Move btnCool(cnt - 1).Left + btnCool(cnt - 1).Width + 1, 2, iWidth, iHeight
  284.       
  285.       btnCool(cnt).DropDown = mNodes.Item(cnt).DropDown
  286.       btnCool(cnt).Enabled = mNodes.Item(cnt).Enabled
  287.       btnCool(cnt).Caption = IIf(bTextLabels, mNodes.Item(cnt).Caption, "")
  288.       btnCool(cnt).ToolTipText = mNodes.Item(cnt).ToolTipText
  289.       btnCool(cnt).Tag = mNodes.Item(cnt).Tag
  290.       btnCool(cnt).Style = mNodes.Item(cnt).Style
  291.       btnCool(cnt).ShowFlatGrey = bShowFlatGrey
  292.       btnCool(cnt).PictureAlign = vbPicTop
  293.       Set btnCool(cnt).Picture = IIf(mNodes.Item(cnt).Bitmap Is Nothing, Nothing, mNodes.Item(cnt).Bitmap)
  294.       mNodes.Item(cnt).Left = btnCool(cnt).Left * Screen.TwipsPerPixelX
  295.       btnCool(cnt).Visible = mNodes.Item(cnt).Visible
  296.     Next
  297.   End If
  298. End Sub
  299. Public Sub RedrawButtons()
  300. Attribute RedrawButtons.VB_Description = "Redraws all buttons from the button collection"
  301. Attribute RedrawButtons.VB_MemberFlags = "40"
  302.   'delete and recreate all buttons
  303.   ShowButtons
  304.   PropertyChanged "Buttons"
  305. End Sub
  306. Public Sub UpdateButtons()
  307.   'redraw all buttons (no delete)
  308.   Dim cnt As Integer, currX As Integer
  309.   Dim iWidth As Integer, iHeight As Integer
  310.   If mNodes.Count = 0 Then
  311.     btnCool(1).Visible = False
  312.   Else
  313.     btnCool(1).Visible = False
  314.     If mNodes.Item(1).DropDown And (mNodes.Item(1).Style = [Cool Button] Or mNodes.Item(1).Style = [Standard Button] Or mNodes.Item(1).Style = [Toolbar Button]) Then
  315.         iWidth = IIf(bTextLabels, 52, 32)
  316.     ElseIf mNodes.Item(1).Style = Separator Or mNodes.Item(1).Style = [Toolbar Handle] Then
  317.         iWidth = 9
  318.     Else
  319.         iWidth = IIf(bTextLabels, 44, 22)
  320.     End If
  321.     iHeight = IIf(bTextLabels, 44, 22)
  322.     btnCool(1).Move 2, 2, iWidth, iHeight
  323.     btnCool(1).Enabled = mNodes.Item(1).Enabled
  324.     btnCool(1).DropDown = mNodes.Item(1).DropDown
  325.     btnCool(1).Caption = IIf(bTextLabels, mNodes.Item(1).Caption, "")
  326.     btnCool(1).ToolTipText = mNodes.Item(1).ToolTipText
  327.     btnCool(1).Tag = mNodes.Item(1).Tag
  328.     btnCool(1).Style = mNodes.Item(1).Style
  329.     btnCool(1).ShowFlatGrey = bShowFlatGrey
  330.     btnCool(1).PictureAlign = vbPicTop
  331.     Set btnCool(1).Picture = IIf(mNodes.Item(1).Bitmap Is Nothing, Nothing, mNodes.Item(1).Bitmap)
  332.     mNodes.Item(1).Left = btnCool(1).Left
  333.     btnCool(1).Visible = mNodes.Item(1).Visible
  334.     For cnt = 2 To mNodes.Count
  335.       btnCool(cnt).Visible = False
  336.       If mNodes.Item(cnt).DropDown And (mNodes.Item(cnt).Style = [Cool Button] Or mNodes.Item(cnt).Style = [Standard Button] Or mNodes.Item(cnt).Style = [Toolbar Button]) Then
  337.         iWidth = IIf(bTextLabels, 52, 32)
  338.       ElseIf mNodes.Item(cnt).Style = Separator Or mNodes.Item(cnt).Style = [Toolbar Handle] Then
  339.         iWidth = 9
  340.       Else
  341.         iWidth = IIf(bTextLabels, 44, 22)
  342.       End If
  343.       iHeight = IIf(bTextLabels, 44, 22)
  344.       btnCool(cnt).Move btnCool(cnt - 1).Left + btnCool(cnt - 1).Width + 1, 2, iWidth, iHeight
  345.       
  346.       btnCool(cnt).DropDown = mNodes.Item(cnt).DropDown
  347.       btnCool(cnt).Enabled = mNodes.Item(cnt).Enabled
  348.       btnCool(cnt).Caption = IIf(bTextLabels, mNodes.Item(cnt).Caption, "")
  349.       btnCool(cnt).ToolTipText = mNodes.Item(cnt).ToolTipText
  350.       btnCool(cnt).Tag = mNodes.Item(cnt).Tag
  351.       btnCool(cnt).Style = mNodes.Item(cnt).Style
  352.       btnCool(cnt).ShowFlatGrey = bShowFlatGrey
  353.       btnCool(cnt).PictureAlign = vbPicTop
  354.       Set btnCool(cnt).Picture = IIf(mNodes.Item(cnt).Bitmap Is Nothing, Nothing, mNodes.Item(cnt).Bitmap)
  355.       mNodes.Item(cnt).Left = btnCool(cnt).Left * Screen.TwipsPerPixelX
  356.       btnCool(cnt).Visible = mNodes.Item(cnt).Visible
  357.     Next
  358.   End If
  359. End Sub
  360. Private Sub RemoveButtons()
  361. Attribute RemoveButtons.VB_Description = "Remove all buttons"
  362. 'remove all buttons from control except base one
  363. Dim cnt As Integer
  364. If btnCool().Count > 1 Then
  365.   For cnt = 2 To btnCool().Count
  366.     Unload btnCool(cnt)
  367.   Next
  368. End If
  369. End Sub
  370. Public Property Get ShowFlatGrey() As Boolean
  371. Attribute ShowFlatGrey.VB_Description = "Get/Sets a value to determine whether or not to display the picture in greyscale when the mouse is not over the button (Cool Button only)"
  372.     ShowFlatGrey = bShowFlatGrey
  373. End Property
  374. Public Property Let ShowFlatGrey(ByVal New_Value As Boolean)
  375.     bShowFlatGrey = New_Value
  376.     UpdateButtons
  377.     PropertyChanged "ShowFlatGrey"
  378. End Property
  379. Public Property Get TextLabels() As Boolean
  380. Attribute TextLabels.VB_Description = "Sets/gets a value to determine whether buttons will show the  text label"
  381.     TextLabels = bTextLabels
  382. End Property
  383. Public Property Let TextLabels(ByVal New_Value As Boolean)
  384.     bTextLabels = New_Value
  385.     UserControl_Resize
  386.     UpdateButtons
  387.     PropertyChanged "TextLabels"
  388. End Property
  389.